home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / examples.arc / EXAMPL63.PRO < prev    next >
Encoding:
Text File  |  1986-10-07  |  2.7 KB  |  89 lines
  1. /*Program 63*/
  2. /*
  3.   The names of the variables are changed
  4.   from the manual to add clarity.
  5. */
  6.  
  7. code = 1000 trail = 1000
  8.  
  9. domains
  10.     arg      = reference var(vid); symb(symbol);  fntr(fid, arglist)
  11.     arglist  = reference arg*
  12.     atom     = atom(aid, arglist) /* atom: is a predicate and arguments */
  13.     atomlist = atom*
  14.     bind     = b(vid, arg)        /* bind: is a variable and the
  15.                                        term(arg) bound to it */
  16.     b_list   = reference bind*    /* variable binding list */
  17.     fid, aid, vid = symbol        /* fid: is functor name  */
  18.                                   /* aid: is atom name     */
  19.                                   /* vid: is variable name */
  20. database
  21.     clause(atom, atomlist)
  22.  
  23. predicates
  24.     call(atom)
  25.     unify_arg(arg, arg, b_list)
  26.     unify_arg_list(arglist, arglist, b_list)
  27.     unify_subgoals(atomlist, b_list)
  28.     member(bind, b_list)
  29.  
  30. goal
  31.     makewindow(1,6,3,"The solution",10,9,12,63),
  32.     write("Remove this goal and enter the other goals on page 150\n\n"),
  33.     call(atom(likes,[Name,Activity])),
  34.     write(Name,Activity),nl,
  35.     fail.
  36.  
  37. clauses
  38.  
  39.     call(atom(Id, Arglist)) :-
  40.         clause(atom(Id,Arglist1), Body),  /* lookup clause  */
  41.         free(B_list),                     /* all variables are free */
  42.         unify_arg_list(Arglist, Arglist1, B_list),
  43.         unify_subgoals(Body, B_list).
  44.  
  45. /*
  46.   unify_arg_list unify the argument list in a clause
  47. */
  48.  
  49.     unify_arg_list([], [], _).
  50.     unify_arg_list([Arg1|ArgLst1],[Arg2|ArgLst2],B_list) :-
  51.         unify_arg(Arg1, Arg2, B_list),
  52.         unify_arg_list(ArgLst1, ArgLst2, B_list).
  53.  
  54. /*
  55.   unify_arg match the arguments in atom and assign variables
  56. */
  57.  
  58.     unify_arg(Arg, var(X), B_list) :-
  59.         member(b(X,Arg),B_list), !.
  60.     unify_arg(symb(X), symb(X), _).                  /* symbols match   */
  61.     unify_arg(fntr(Id, Lst1), fntr(Id,Lst2),Bind) :- /* functor &       */
  62.         unify_arg_list(Lst1, Lst2, Bind).            /* arguments match */
  63.  
  64. /*
  65.   unify_subgoals unification down the goal stack
  66. */
  67.  
  68.     unify_subgoals([],_).
  69.     unify_subgoals([atom(Id,ArgLst)|AtomLst],B_list) :-
  70.         unify_arg_list(Call,ArgLst,B_list), call(atom(Id,Call)),
  71.         unify_subgoals(AtomLst,B_list).
  72.  
  73.     member(X,[X|_]).
  74.     member(X,[_|Lst]) :-
  75.     member(X,Lst).
  76.  
  77. /*
  78.   DATABASE FACTS ASSERTED
  79.   facts can either be asserted on the fly or as part of
  80.   the code as shown here.
  81. */
  82.  
  83.     clause(atom(likes,[symb(ellen),symb(tennis)]), []).
  84.     clause(atom(likes,[symb(john),symb(football)]), []).
  85.     clause(atom(likes,[symb(eric),symb(swimming)]), []).
  86.     clause(atom(likes,[symb(mark),symb(tennis)]), []).
  87.     clause(atom(likes,[symb(bill),var(x)]),
  88.           [atom(likes,[symb(tom), var(x)])]).
  89.